home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / nrcobol_1e.lha / NRCOBOL1e / COBFILES / MAINTEST.COB < prev    next >
Text File  |  1998-02-04  |  9KB  |  233 lines
  1.        IDENTIFICATION DIVISION.
  2.        PROGRAM-ID.   MAINTEST.
  3.       *AUTHOR.       cHArRiOTt.
  4.        ENVIRONMENT DIVISION.
  5.  
  6.        CONFIGURATION SECTION.
  7.        SOURCE-COMPUTER.   AMSTRAD 1512.
  8.        OBJECT-COMPUTER.
  9.        SPECIAL-names.
  10.            CURRENCY IS "£".
  11.  
  12.       *
  13.        DATA DIVISION.
  14.        FILE SECTION.
  15.       *
  16.        WORKING-STORAGE SECTION.
  17.        01 WS-TEST PIC X(10) VALUE SPACES.
  18.        01 WORKING-DATA.
  19.            03 WS-BLOCK-DATA PIC X(40) VALUE
  20.               "123456789012345678901234EFGH901234567890".
  21.       *        1   2   3   4   5   1   2   3   4   5
  22.        01 WORKING-TABLE REDEFINES WORKING-DATA.
  23.            03 WS-OUTER OCCURS 2 TIMES.
  24.               05 WS-TABLE-DATA PIC X(4) OCCURS 5 TIMES.
  25.  
  26.        01 ws-search-table redefines working-data.
  27.            03 ws-search occurs 20 times 
  28.                         descending key is ws-text indexed by index-temp.
  29.               05 ws-text pic xx.
  30.        01 ws-number      pic 9(5) value 1.
  31.       * SIGN TRAILING
  32.        01 WS-TEST1 PIC S9(8)V999  SIGN TRAILING VALUE +8.54.
  33.        01 WS-TEST2 PIC S9(8)V999 VALUE +94.33.
  34.        01 WS-TEST3 PIC S9(8)V999  SIGN LEADING VALUE -24.85.
  35.        01 WS-TEST4 PIC 9999      VALUE 00.
  36.        01 WS-TEST5 PIC S9(6)V999 VALUE 2.
  37.        01 WS-TEST6 PIC £(6).999+ .
  38.        01 WS-TEST6a PIC £(6)+ .
  39.        01 WS-TEST7 PIC S9(6)     VALUE 2.
  40.        01 WS-TEMP-DATA PIC X(40) VALUE
  41.              "1 2 3 4 5 6 7 8 9 1011121314151617181920".
  42.        01 WS-TEST8 PIC X(14).
  43.        01 WS-TIME.
  44.            03 WS-HRS PIC 9(2) VALUE 00.
  45.            03 WS-MIN PIC 9(2) VALUE 00.
  46.            03 WS-SEC PIC 9(2) VALUE 00.
  47.            03 WS-MIC PIC 9(2) VALUE 00.
  48.       * 01 WS-TIME REDEFINES WS-TIME0 PIC 9(8).
  49.  
  50.        01 WS-TIME2.
  51.            03 WS-HRS2 PIC 9(2) VALUE 00.
  52.            03 WS-MIN2 PIC 9(2) VALUE 00.
  53.            03 WS-SEC2 PIC 9(2) VALUE 00.
  54.       * 01 WS-TIME2 REDEFINES WS-TIME1 PIC 9(6). 
  55.  
  56.        01 WS-PAGE-COUNTER  PIC 9(8)V9999999999   VALUE 00.
  57.        01 WS-PAGE-COUNTER2 PIC +(7)9.9999999999 .
  58.        01 WS-TESTJUMP      PIC 9.
  59.        01 WS-FIND          PIC XXX VALUE "456".
  60.        01 WS-JUSTTEST.
  61.            03 JL PIC X(5).
  62.            03 JR PIC X(5) JUST RIGHT.
  63.  
  64.  
  65.        01 WS-STRINGTEST.
  66.            03 WS-STRING1 PIC X(12).
  67.            03 WS-STRING2 PIC X(12).
  68.            03 WS-STRING3 PIC X(12).
  69.            03 WS-STRING4 PIC X(12).
  70.  
  71.        01 WS-TEST-DIS.
  72.            03 NUMBER1 PIC 99 VALUE 14.
  73.            03 NUMBER2 PIC 99 VALUE 28.
  74.        01 ws-long-string pic x(120) value  "1 2 3 4 5 6 7 8 9 1011121314
  75.       -    "1516171819201 2 3 4 5 6 7 8 9 10111213141516171819201 2 3  5
  76.       -    " 6 7 8 9 1011121314151617181920".
  77.       *
  78.        SCREEN SECTION.
  79.        01 BLANK-SCREEN.
  80.            03 BLANK SCREEN.
  81.        01 PROG-DISCRIPTION.
  82.            03 LINE 2 COLUMN 20  VALUE
  83.               "SHORT PROGRAM TO TEST DISPLAY FUNCTION  ".
  84.            03 LINE 2 COLUMN 60 PIC 99I:99I:99 FROM WS-TIME2.
  85.        01 SET-COLOURS.
  86.            03 FOREGROUND-COLOR 4 BACKGROUND-COLOR 0.
  87.       *
  88.        PROCEDURE DIVISION.
  89.       *
  90.        0000-MAIN.
  91.            DISPLAY SET-COLOURS.
  92.            ACCEPT WS-TIME FROM TIME.
  93.            MOVE WS-HRS TO WS-HRS2.
  94.            MOVE WS-MIN TO WS-MIN2.
  95.            MOVE WS-SEC TO WS-SEC2.
  96.  
  97.            DISPLAY BLANK-SCREEN.
  98.            DISPLAY PROG-DISCRIPTION.
  99.            DISPLAY (4  1)  "ENTER VALUE FOR WS-TABLE-BLOCK 40 MAX :"
  100.            ACCEPT  (4  39) WS-BLOCK-DATA.
  101.       *
  102.       *     
  103.            INSPECT WS-BLOCK-DATA 
  104.                    TALLYING WS-TEST4 FOR ALL "456"  ALL "789"
  105.                             WS-TEST4 FOR ALL "789"
  106.                    REPLACING ALL "456" BY "ACE" AFTER INITIAL "8"
  107.                              ALL "901" BY "WOW"
  108.                              ALL LOW-VALUES BY SPACE.
  109.  
  110.            DISPLAY (5  5)  "THE VALUE OF WS-TABLE-BLOCK :".
  111.            DISPLAY (6 10) "'" WS-BLOCK-DATA "'".
  112.            DISPLAY (7 10) "'" WS-TEMP-DATA "'".
  113.       *    DISPLAY (8 5)  "NUMBER OF '456' FOUND IN WS-BLOCK-DATA IS "
  114.       *                    WS-TEST4.
  115.  
  116.            DISPLAY (9  5)  "THE VALUE OF WS-TABLE-DATA :".
  117.            DISPLAY (11 24) "(1 3) = " WS-TABLE-DATA (1 3).
  118.            DISPLAY (12 24) "(2 3) = " WS-TABLE-DATA (2 3).
  119.            DISPLAY (13 24) "(1 5) = " WS-TABLE-DATA (1 5).
  120.            DISPLAY (14 24) "(1 4) = " WS-TABLE-DATA (1 4).
  121.  
  122.            DISPLAY (15 5) "ENTER JUMP CODE 1 - 3 : " NO ADVANCING.
  123.            ACCEPT  WS-TESTJUMP.
  124.  
  125.            IF (WS-TABLE-DATA (1 3) IS NUMERIC)
  126.               COMPUTE WS-PAGE-COUNTER = 6 * (7 + 2 / (4 ** 3))
  127.               MOVE WS-PAGE-COUNTER TO WS-PAGE-COUNTER2
  128.               DISPLAY (15 5)
  129.                    "TESTING COMPUTE: 6 * (7 + 2 / (4 ** 3)) = "
  130.                    WS-PAGE-COUNTER2
  131.       *       compute ws-page-counter = 22 / 7
  132.               DIVIDE 22 BY 7 GIVING ws-page-counter rounded
  133.               move ws-page-counter to ws-page-counter2
  134.               display (18 5)
  135.                    "TESTING DIVIDE FUNCTION : 22 / 7 = "
  136.                    WS-PAGE-COUNTER2
  137.               compute ws-page-counter = 457985 / 7
  138.               move ws-page-counter to ws-page-counter2
  139.       *        move ws-page-counter2 to ws-page-counter
  140.               display (17 5)
  141.                    "TESTING DIVIDE FUNCTION : 457985 / 7 = "
  142.                    WS-PAGE-COUNTER2
  143.  
  144.               set index-temp to 1
  145.               search all ws-search 
  146.                    at end display (20 5) "ending search test!"
  147.                    when ws-text (index-temp) = "22"
  148.                         set ws-number to index-temp
  149.                         display (21 5) "search found 22 at " ws-number
  150.               end-search
  151.       *       display (20 47) "test too long string : " ws-long-string
  152.               move ws-test2 to WS-PAGE-COUNTER2
  153.               display (22 10) "leading sign ok?  " WS-PAGE-COUNTER2
  154.       *       move ws-test2 to ws-test3
  155.               move ws-test3 to ws-test8
  156.               move ws-test3 to WS-PAGE-COUNTER2
  157.               display (23 10) "trailing sign ok? " ws-test8
  158.            ELSE
  159.               EVALUATE WS-TESTJUMP
  160.                  WHEN  1          GO TO 200-DISPLAY-EXIT
  161.                  WHEN  2          GO TO 300-DISPLAY-EXIT
  162.                  WHEN  3  THRU 6  GO TO 400-DISPLAY-EXIT
  163.                  WHEN OTHER GO TO 500-DISPLAY-EXIT.
  164.  
  165.        100-EXIT.               
  166.            STOP RUN.
  167.  
  168.        200-DISPLAY-EXIT.
  169.            DISPLAY (16 5)
  170.               "TEST DATA JUMP 1".
  171.            CALL "TEST1" .
  172.            CALL "TEST2" USING CONTENT NUMBER1 CONTENT NUMBER2.
  173.       *    CALL "TEST2" USING CONTENT NUMBER1 REFERENCE NUMBER2.
  174.            DISPLAY "TEST CALL 2: 14 + 28 = " NUMBER2.
  175.  
  176.            GO TO 100-EXIT.
  177.  
  178.        300-DISPLAY-EXIT.
  179.            DISPLAY (16 5) 
  180.               "TEST DATA JUMP 2".
  181.            GO TO 100-EXIT.
  182.  
  183.        400-DISPLAY-EXIT.
  184.            DISPLAY (16 5) 
  185.               "TEST DATA JUMP 3".
  186.            GO TO 100-EXIT.
  187.  
  188.        500-DISPLAY-EXIT.
  189.            DISPLAY (16 5)
  190.               "TEST DATA JUMP 4: DATA SHOULD BE IN RANGE 1-3".
  191.            MOVE 6 TO WS-TEST4.
  192.            MOVE "THREE FOUR  "  TO WS-STRING1.
  193.            MOVE "FIVE SIX    "  TO WS-STRING2.
  194.            MOVE "SEVEN EIGHT "  TO WS-STRING3.
  195.            MOVE "NINE TEN.   "  TO WS-STRING4.
  196.  
  197.            STRING " ONE TWO " DELIMITED BY SIZE
  198.                   WS-STRING1  "," WS-STRING2 DELIMITED BY SPACE
  199.                   "," WS-STRING3 "END" DELIMITED BY "."
  200.                  INTO WS-BLOCK-DATA POINTER WS-TEST4
  201.                  OVERFLOW DISPLAY "WARNING WS-BLOCK-DATA OVERFLOW!!".
  202.  
  203.            DISPLAY (18 5) "TEST USING " " ONE TWO " WS-STRING1 
  204.                  "," WS-STRING2 "," WS-STRING3.
  205.  
  206.            DISPLAY (19 5) "STRING TEST :" WS-BLOCK-DATA.
  207.  
  208.       * had test here for UNSTRING function later....
  209.  
  210.            MOVE 6 TO WS-TEST4.
  211.            UNSTRING WS-BLOCK-DATA 
  212.                INTO WS-STRING1 WS-STRING2 WS-STRING3 WS-STRING4  
  213.                POINTER WS-TEST4
  214.                OVERFLOW DISPLAY "WARNING WS-BLOCK-DATA OVERFLOW!!".
  215.  
  216.            DISPLAY (20 5) "'" WS-BLOCK-DATA "'". 
  217.            DISPLAY (21 5) "WS-BLOCK-DATA UNSTRINGS TO FORM ...".
  218.            DISPLAY (22 5) "'" WS-STRING1 "' , '" WS-STRING2 "' , '" 
  219.                           WS-STRING3 "' , '" WS-STRING4 "'.".
  220.  
  221.